home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / EDUCATE / RADDECAY.ARJ / RADDKLIB.TRU < prev    next >
Text File  |  1987-11-19  |  51KB  |  1,017 lines
  1. MODULE raddklib
  2. ! 9/28/87
  3. DECLARE PUBLIC true,false,recpath$,va$,screen$
  4. DECLARE PUBLIC nuclide$(),first_time,at_names$(),mol_wt()
  5. SHARE blank$,a$(63)
  6. SHARE element_ID(497)             ! element index corresponding to alphbetic sequence
  7. DECLARE DEF spaces$,rjust$,ljust$,center$,notrail$
  8. LET first_time = 1                ! that is, true
  9.  
  10. SUB pick_one_nuclide(pick_nuclide)
  11.     ! 9/27/87
  12.     ! This routine selects a nuclide from a name display and returns their array indices
  13.     ! a$ is an array to be scrolled; each a$ contains eight nuclide names
  14.  
  15.     ! array index for nuclide based on position
  16.     DEF iso_index(defrow,defcolumn) = (defrow - 1)*8 + defcolumn
  17.  
  18.     DIM flag(497)
  19.     LET numnucl = 497
  20.     CALL divide( numnucl,8,maxrows,lastcol)
  21.     IF lastcol > 0 then LET maxrows = maxrows + 1
  22.     IF lastcol = 0 then LET lastcol = 8
  23.     LET indent = 5                ! tab location of first name
  24.     LET line1 = 5                 ! first printed line on screen
  25.     LET lastline = 24             ! last printed line on screen
  26.     LET columns = 8               ! number of names horizontally on each row
  27.     LET width = 9                 ! field width for each name
  28.     LET lines = lastline - line1 + 1   ! number of lines on page
  29.     FOR row = 1 to maxrows
  30.         ! set up strings for scrolling
  31.         LET a$(row) = repeat$(" ",indent-1)
  32.         FOR column = 1 to columns
  33.             LET index = iso_index(row,column)
  34.             IF index <= numnucl then LET a$(row) = a$(row) & nuclide$(index) & " "
  35.         NEXT column
  36.     NEXT row
  37.     IF first_time = false then
  38.        CALL textshow(screen$,round(1),round(1))
  39.     ELSE
  40.        CLEAR
  41.        CALL highlight
  42.        CALL print_centered(" SELECT NUCLIDE ")
  43.        CALL normal
  44.        CALL print_centered("Use arrow keys, [PgUp], [PgDn], [Home], [End] for locating.")
  45.        CALL print_centered("Press [Enter] to select a nuclide; [Esc] to abandon.")
  46.        PRINT repeat$("═",80);
  47.        ! fill initial screenful
  48.        FOR row = 1 to lines       ! fills from top down
  49.            PRINT tab(line1+row-1,2); a$(row)
  50.            FOR column = 1 to columns
  51.                LET index = iso_index(row,column)
  52.                IF index <= numnucl then CALL check_pick(index,row,column,flag(index),0)
  53.            NEXT column
  54.        NEXT row
  55.        CALL textkeep(1,80,1,25,screen$)
  56.        LET first_time = false
  57.     END IF
  58.     LET last = lines              ! row of a$ that is displayed last on the page
  59.     LET row = 1                   ! row in array 1 to maxrows
  60.     LET column = 1                ! horizontal location of cursor
  61.     LET first = 1                 ! row of a$ that is displayed first on the page
  62.     LET vert = 1                  ! cursor vertical position, screen line after line 1 
  63.     LET index = 1
  64.     CALL check_pick(index,vert,column,2,1)  ! shows first position in inverse
  65.     WHEN error in
  66.          DO
  67.             CALL getkey(key)
  68.             SELECT CASE key
  69.             CASE 13               ! done - reassign values,then exit subroutine
  70.                  LET pick_nuclide = iso_index(row,column)  ! rtn answer
  71.                  EXIT SUB
  72.             CASE 27
  73.                  CAUSE ERROR 100  ! leave via error handler without any changes
  74.             CASE 327,328,329,331,333,335,336,337      ! cursor moves
  75.                  CALL check_pick(index,vert,column,flag(index),1)
  76.                  SELECT CASE key
  77.                  CASE 327         ! Home
  78.                       FOR i =  row to 1 step -1
  79.                           CALL up_one  ! scroll the whole business
  80.                       NEXT i
  81.                       LET column = 1
  82.                       LET row = 1
  83.                       LET vert = 1
  84.                  CASE 335         ! end
  85.                       FOR i =  row to maxrows
  86.                           CALL down_one     ! scroll the whole business
  87.                       NEXT i
  88.                       LET row = maxrows
  89.                       LET vert = lines
  90.                       LET column = lastcol
  91.                  CASE 328         ! up cursor
  92.                       IF vert > 1 then
  93.                          LET row = row - 1
  94.                          LET vert = vert - 1
  95.                       ELSE
  96.                          CALL up_one
  97.                          LET row = max(1,row - 1)
  98.                       END IF
  99.                  CASE 329         ! PgUp
  100.                       LET diff = last - row
  101.                       FOR i = 1 to lines
  102.                           CALL up_one
  103.                       NEXT i
  104.                       LET row = last - diff
  105.                  CASE 331         ! left cursor
  106.                       LET column = column - 1
  107.                       IF column < 1 then
  108.                          LET column = columns
  109.                          IF row = maxrows and column > lastcol then LET column = lastcol
  110.                       END IF
  111.                  CASE 333         ! right cursor
  112.                       LET column = column + 1
  113.                       IF column > columns then LET column = 1
  114.                       IF row = maxrows and column > lastcol then LET column = 1
  115.                  CASE 336         ! down cursor
  116.                       IF vert < lines then
  117.                          LET row = row + 1
  118.                          LET vert = vert + 1
  119.                       ELSE
  120.                          CALL down_one
  121.                          LET row = min(maxrows,row + 1)
  122.                       END IF
  123.                       IF row = maxrows and column > lastcol then LET column = lastcol
  124.                  CASE 337         ! PgDn
  125.                       LET diff = row - first
  126.                       FOR i = lines to 1 step -1
  127.                           CALL down_one
  128.                       NEXT i
  129.                       LET row = first + diff
  130.                       IF row = maxrows and column > lastcol then LET column = lastcol
  131.                  END SELECT
  132.                  LET index = iso_index(row,column)
  133.                  CALL check_pick(index,vert,column,2,1)
  134.             CASE ELSE
  135.             END SELECT
  136.          LOOP
  137.     USE
  138.          IF extype = 100 then
  139.             EXIT HANDLER          ! handle at higher level
  140.          ELSE                     ! unexpected
  141.             CALL fatal(0,"","")
  142.          END IF
  143.     END WHEN
  144.  
  145.     SUB down_one
  146.         ! move down one line - scroll page up one line if on bottom line
  147.         IF last < maxrows then
  148.            CALL scroll(line1,2,lastline,78,1)
  149.            LET last = last + 1
  150.            SET CURSOR lastline,2
  151.            PRINT a$(last);
  152.            FOR horz = 1 to columns
  153.                LET index2 = iso_index(last,horz)
  154.                IF index2 <= numnucl then  CALL check_pick(index2,lines,horz,flag(index2),0)
  155.            NEXT horz
  156.            LET first = first + 1
  157.         END IF
  158.     END SUB
  159.  
  160.     SUB up_one
  161.         ! move up one line - scroll page down one line if on top line
  162.         IF first > 1 then
  163.            CALL scroll(line1,2,lastline,78,-1)
  164.            LET first = first - 1
  165.            SET CURSOR line1,2
  166.            PRINT a$(first);
  167.            FOR horz = 1 to columns
  168.                LET index2 = iso_index(first,horz)
  169.                CALL check_pick(index2,1,horz,flag(index2),0)
  170.            NEXT horz
  171.            LET last = last - 1
  172.         END IF
  173.     END SUB
  174.  
  175.     SUB check_pick(chekindx,printrow,printcolumn,chekflg,onetime)
  176.         ! print nuclide$(chekindx) in proper color 
  177.         SELECT CASE chekflg
  178.         CASE 0                    ! indicates that no display change is required
  179.              IF onetime = 0 then EXIT SUB   ! whole line already printed
  180.         CASE 1                    ! indicates that nuclide$(chekindx) is selected
  181.              CALL highlight
  182.         CASE 2                    ! indicates that cursor is on nuclide$(chekindx)
  183.              CALL inverse
  184.         CASE ELSE
  185.         END SELECT
  186.         SET CURSOR line1 + printrow - 1,indent + (printcolumn-1)*width + 1
  187.         PRINT nuclide$(chekindx);
  188.         LET nameandno$ = center$(" Cursor on: "&at_names$(element_ID(chekindx))&" - Index: "&str$(chekindx)& " ",80,"═")
  189.         CALL highlight
  190.         PRINT tab(4,1);nameandno$;
  191.         CALL normal
  192.     END SUB
  193. END SUB
  194.  
  195. SUB show_nuclide(nuclide)
  196.     ! retrieves information and displays information for record nuclide
  197.     ! nuclide is the record # in the NUCLIDES.REC file
  198.     DEF file$(str$) = recpath$ & str$ & ".REC"
  199.  
  200.     DIM daughter_id(2),daughter_branch(2),var(200,3),msg$(2)
  201.     DIM chainID(31),afinal(31),decay(5)     ! needed for displaying chain
  202.     DO                            ! until successful or user quits
  203.        WHEN error in
  204.             OPEN #1: name file$("NUCLIDES"), access input, recsize 41
  205.             SET #1: RECORD nuclide
  206.             READ #1: record$
  207.             CLOSE #1
  208.             EXIT DO
  209.        USE
  210.             CLOSE #1
  211.             CALL file_err("Unable to read nuclide file:",file$("NUCLIDES"))
  212.        END WHEN
  213.     LOOP
  214.     CALL uncram_record
  215.     IF unit$ = "S" then LET half_time$ = "seconds"
  216.     IF unit$ = "M" then LET half_time$ = "minutes"
  217.     IF unit$ = "H" then LET half_time$ = "hours"
  218.     IF unit$ = "D" then LET half_time$ = "days"
  219.     IF unit$ = "Y" then LET half_time$ = "years"
  220.     IF daughters > 0 then
  221.        DO                         ! until successful or user quits
  222.           WHEN error in
  223.                OPEN #1: name file$("PROGENY"), recsize 16, access input
  224.                FOR i = 1 to daughters
  225.                    LET R = daughter_pointer + i - 1
  226.                    SET #1: RECORD R
  227.                    READ #1: record$
  228.                    LET daughter_id(i) = num(record$[1:8])
  229.                    LET daughter_branch(i) = num(record$[9:16])
  230.                NEXT i
  231.                CLOSE #1
  232.                EXIT DO
  233.           USE
  234.                CLOSE #1
  235.                CALL file_err("Unable to read nuclide file:",file$("PROGENY"))
  236.           END WHEN
  237.        LOOP
  238.     END IF
  239.  
  240.     ! Show radionuclide characteristics
  241.     CLEAR
  242.     CALL plain_double_edge_box(1,1,33,5)
  243.     CALL plain_double_edge_box(6,1,33,25)
  244.     CALL plain_double_edge_box(1,34,80,25)
  245.     LET trimmed_name$ = trim$(nuclide_name$)
  246.     CALL textkeep(35,79,2,24,blank$)   ! for blanking right side box
  247.     CALL highlight
  248.     PRINT tab(3,16-len(trimmed_name$)/2); " "&trimmed_name$&" "
  249.     CALL normal
  250.     LET nameprint$ = "("&at_names$(at_no)&")"
  251.     PRINT tab(4,17-len(nameprint$)/2);nameprint$
  252.     SET CURSOR 7,1
  253.     PRINT "║ Atomic number :";at_no
  254.     PRINT "║ Element weight:";mol_wt(at_no)
  255.     IF half_life < 99000 then
  256.        PRINT    "║ Half life     :";half_life;
  257.     ELSE
  258.        PRINT using "║ Half life     :#.###^^^^ ":half_life;
  259.     END IF
  260.     PRINT half_time$
  261.     FOR i = 1 to daughters
  262.         PRINT using "║ Daughter      : ########":nuclide$(daughter_id(i))
  263.         PRINT       "║ Branch ratio  :"; daughter_branch(i)     ! branching is branching ratio
  264.     NEXT i
  265.     SET CURSOR 14,1
  266.     PRINT       "║ Record files info retrieval:"
  267.     PRINT       "║             Number of   press"
  268.     PRINT       "║              records     key "
  269.     PRINT using "║ Alphas   :    ####       [A]": alphas
  270.     PRINT using "║ Betas    :    ####       [B]": betas
  271.     PRINT using "║ Positrons:    ####       [P]": positrons
  272.     PRINT using "║ Electrons:    ####       [E]": electrons
  273.     PRINT using "║ Gammas   :    ####       [G]": photons
  274.     PRINT       "║ (and X rays)                "
  275.     PRINT
  276.     PRINT       "║";
  277.     CALL highlight
  278.     PRINT " Return to names list   [Esc] ";
  279.     CALL normal
  280.     CALL show_nuclide_instruction
  281.  
  282.     ! Now display the decay product characteristics
  283.     DO
  284.        CALL getkey(key)
  285.        SELECT CASE key
  286.        CASE 97,65                 ! a or A
  287.             IF alphas > 0 then
  288.                CALL get_var(#2,var,file$("ALPHA"),alphas,alpha_pointer,2,ok)
  289.                IF ok = false then EXIT DO
  290.                CALL show_var(var,"Alphas",alphas,2)
  291.             END IF
  292.        CASE 98,66                 ! b or B
  293.             IF betas > 0 then
  294.                CALL get_var(#2,var,file$("BETAS"),betas,beta_pointer,3,ok)
  295.                IF ok = false then EXIT DO
  296.                CALL show_var(var,"Betas",betas,3)
  297.             END IF
  298.        CASE 112,80                ! p or P
  299.             IF positrons > 0 then
  300.                CALL get_var(#2,var,file$("POSITRON"),positrons,positron_pointer,3,ok)
  301.                IF ok = false then EXIT DO
  302.                CALL show_var(var,"Positrons",positrons,3)
  303.             END IF
  304.        CASE 101,69                ! e or E
  305.             IF electrons > 0 then
  306.                CALL get_var(#2,var,file$("ELECTRON"),electrons,electron_pointer,2,ok)
  307.                IF ok = false then EXIT DO
  308.                CALL show_var(var,"Electrons",electrons,2)
  309.             END IF
  310.        CASE 71,103                ! g or G
  311.             IF photons > 0 then
  312.                CALL get_var(#2,var,file$("PHOTONS"),photons,photon_pointer,2,ok)
  313.                IF ok = false then EXIT DO
  314.                CALL show_var(var,"Gammas & X-rays",photons,2)
  315.             END IF
  316.        CASE 13,27                 ! [Return],[Esc]
  317.             EXIT DO
  318.        CASE 68,100                ! [D],[d] - show display chain for nuclide
  319.             CALL save_screen      ! remember screen
  320.             CALL decay_period(decay)   ! get decay time
  321.             CALL days(dkdays,decay)    ! convert decay period to days
  322.             CALL restore_screen
  323.             CALL number_box(activity)
  324.             CALL decay_chain(nuclide,activity,chainID,afinal,dkdays,true)
  325.             CALL restore_screen
  326.        CASE 42,315                ! Printer request - [PrtSc] or [F1]
  327.             CALL textshow(blank$,round(35),round(2))
  328.             CALL blink
  329.             PRINT tab(13,35);center$("PRINTING",45," ")
  330.             CALL normal
  331.             CALL print_nuclide_information
  332.             CALL show_nuclide_instruction
  333.        CASE else
  334.        END SELECT
  335.     LOOP
  336.  
  337.     SUB print_nuclide_information
  338.         WHEN error in
  339.              OPEN # 5: printer
  340.              PRINT #5
  341.              PRINT #5: tab(23-len(trimmed_name$)/2); trimmed_name$
  342.              PRINT #5: tab(23-len(trimmed_name$)/2); repeat$("=",len(trimmed_name$))
  343.              PRINT #5
  344.              PRINT #5: tab(8);"Atomic number     :";at_no
  345.              PRINT #5: tab(8);"Atomic weight     :";at_weight
  346.              PRINT #5: tab(8);"Half life         :";half_life;half_time$
  347.              FOR i = 1 to daughters
  348.                  PRINT #5: tab(8);"Daughter          : "; nuclide$(daughter_id(i))
  349.                  PRINT #5: tab(8);"Branching fraction:"; daughter_branch(i)
  350.              NEXT i
  351.              IF alphas > 0 then
  352.                 CALL get_var(#2,var,file$("ALPHA"),alphas,alpha_pointer,2,ok)
  353.                 IF ok = true then CALL print_var(#5,var,"Alphas",alphas,2)
  354.              END IF
  355.              IF betas > 0 then
  356.                 CALL get_var(#2,var,file$("BETAS"),betas,beta_pointer,3,ok)
  357.                 IF ok = true then CALL print_var(#5,var,"Betas",betas,3)
  358.              END IF
  359.              IF positrons > 0 then
  360.                 CALL get_var(#2,var,file$("POSITRON"),positrons,positron_pointer,3,ok)
  361.                 IF ok = true then CALL print_var(#5,var,"Positrons",positrons,3)
  362.              END IF
  363.              IF electrons > 0 then
  364.                 CALL get_var(#2,var,file$("ELECTRON"),electrons,electron_pointer,2,ok)
  365.                 IF ok = true then CALL print_var(#5,var,"Electrons",electrons,2)
  366.              END IF
  367.              IF photons > 0 then
  368.                 CALL get_var(#2,var,file$("PHOTONS"),photons,photon_pointer,2,ok)
  369.                 IF ok = true then CALL print_var(#5,var,"Gammas & X-rays",photons,2)
  370.              END IF
  371.              PRINT #5: chr$(12)   ! formfeed
  372.              CLOSE #5
  373.         USE
  374.              WHEN error in
  375.                   CLOSE #5
  376.              USE                  ! ignore err
  377.              END WHEN
  378.              CALL bleep
  379.              LET msg$(1) = " PRINTER ERROR! "
  380.              LET msg$(2) = " Please fix and try again."
  381.              CALL info_window(msg$,0)
  382.         END WHEN
  383.     END SUB
  384.  
  385.     SUB uncram_record
  386.         ! TrueBasic unpackb unpacks an integer from bit locations as specified
  387.         ! Atomic weight has been left as a number in anticpation of eventual precise values
  388.         ! record$ contains 41 bytes, packed into 324 bits; 40 bytes & 2 bits
  389.         LET nuclide_name$    = record$[1:8]
  390.         LET at_weight        = num(record$[9:16])     ! atomic weight; 8 bytes
  391.         LET at_no            = unpackb(record$,129, 8)     ! byte 17
  392.         LET half_life        = num(record$[18:25])
  393.         LET unit$            = record$[26:26]
  394.         LET daughters        = unpackb(record$,209, 2)
  395.         LET daughter_pointer = unpackb(record$,211, 9)
  396.         LET alphas           = unpackb(record$,220, 7)
  397.         LET alpha_pointer    = unpackb(record$,227,13)
  398.         LET betas            = unpackb(record$,240, 8)
  399.         LET beta_pointer     = unpackb(record$,248,13)
  400.         LET positrons        = unpackb(record$,261, 8)
  401.         LET positron_pointer = unpackb(record$,269,13)
  402.         LET electrons        = unpackb(record$,282, 8)
  403.         LET electron_pointer = unpackb(record$,290,13)
  404.         LET photons          = unpackb(record$,303, 8)
  405.         LET photon_pointer   = unpackb(record$,311,13)
  406.     END SUB
  407. END SUB
  408.  
  409. SUB get_var(#999,var(,),file_name$,sets,set_pointer,indices,ok)
  410.     MAT var = zer
  411.     DO                            ! until successful or user quits
  412.        WHEN error in
  413.             OPEN #999: name file_name$,access input,recsize 8*indices
  414.             EXIT DO
  415.        USE
  416.             CLOSE #999
  417.             CALL file_err("Unable to read nuclide file:",file_name$)
  418.        END WHEN
  419.     LOOP
  420.     LET ok = true
  421.     FOR i = 1 to sets
  422.         LET R =  set_pointer + i - 1
  423.         SET #999: RECORD R
  424.         READ #999: record$
  425.         IF indices = 2 then
  426.            LET var(i,1) = num(record$[1:8])
  427.            LET var(i,2) = num(record$[9:16])
  428.         ELSE
  429.            LET var(i,1) = num(record$[1:8])
  430.            LET var(i,2) = num(record$[9:16])
  431.            LET var(i,3) = num(record$[17:24])
  432.         END IF
  433.     NEXT i
  434.     CLOSE #999
  435. END SUB
  436.  
  437. SUB print_var(#5,var(,),text$,sets,indices)
  438.     PRINT #5:
  439.     PRINT #5: tab(7);repeat$("=",(14-len(text$)/2));"  ";text$;":  ";repeat$("=",(14-len(text$)/2))
  440.     PRINT #5:
  441.     IF indices = 3 then
  442.        PRINT #5: tab(5);"      probability    maximum    average"
  443.        PRINT #5: tab(5);"       per decay      (MEV)      (MEV)"
  444.     ELSE
  445.        PRINT #5: tab(5);"      probability    energy"
  446.        PRINT #5: tab(5);"       per decay      (MEV)"
  447.     END IF
  448.     PRINT #5:
  449.     FOR i = 1 to sets
  450.         IF indices = 3 then
  451.            PRINT #5: tab(5);
  452.            PRINT #5,using " ###  ##.######    ##.######":i,var(i,3),var(i,1);
  453.            ! the following is to accomodate lack of info for C-15
  454.            IF var(i,2) < 99 then PRINT #5,using "  ##.######":var(i,2) else PRINT #5
  455.         ELSE
  456.            PRINT #5: tab(5);
  457.            PRINT #5,using " ###  ##.######    ##.######":i,var(i,2),var(i,1)
  458.         END IF
  459.     NEXT i
  460. END SUB
  461.  
  462. SUB show_var(var(,),text$,sets,indices)
  463.     ! indices is number of entries per set; must be 2 or 3
  464.     DIM b$(200)
  465.     CALL textshow(blank$,round(35),round(2))
  466.     PRINT tab(2,(56 - len(text$)/2));text$
  467.     IF indices = 3 then
  468.        PRINT tab(36);"      probability   maximum    average"
  469.        PRINT tab(36);"       per decay     (MEV)      (MEV)"
  470.     ELSE
  471.        PRINT tab(36);"      probability   energy"
  472.        PRINT tab(36);"       per decay     (MEV)"
  473.     END IF
  474.     IF sets > 20 then
  475.        FOR i = 1 to sets
  476.            IF indices = 3 then
  477.               LET b$(i) = using$(" ###  ##.######    ##.######",i,var(i,3),var(i,1))
  478.               ! the following is to accomodate lack of info for C-15
  479.               IF var(i,2) < 99 then LET b$(i) = b$(i) & using$("  ##.######",var(i,2))
  480.            ELSE
  481.               LET b$(i) = using$(" ###  ##.######    ##.######",i,var(i,2),var(i,1))
  482.            END IF
  483.        NEXT i
  484.        LET first = 1
  485.        CALL scroll_it(b$,sets,first,last,5,24,0,36,79)
  486.        DO
  487.           CALL getkey(key)
  488.           SELECT CASE key
  489.           CASE 328,329,336,337
  490.                CALL scroll_it(b$,sets,first,last,5,24,key,36,79)
  491.           CASE 13,27
  492.                EXIT DO
  493.           CASE ELSE
  494.           END SELECT
  495.        LOOP
  496.     ELSE
  497.        FOR i = 1 to sets
  498.            SET CURSOR i+4,36
  499.            IF indices = 3 then
  500.               PRINT using " ###  ##.######    ##.######":i,var(i,3),var(i,1);
  501.               ! the following is to accomodate lack of info for C-15
  502.               IF var(i,2) < 99 then PRINT using "  ##.######":var(i,2) else PRINT
  503.            ELSE
  504.               PRINT using " ###  ##.######    ##.######":i,var(i,2),var(i,1)
  505.            END IF
  506.        NEXT i
  507.        DO
  508.           CALL getkey(key)
  509.           IF key = 13 or key = 27 then EXIT DO
  510.        LOOP
  511.     END IF
  512.     CALL show_nuclide_instruction
  513. END SUB
  514.  
  515. SUB show_nuclide_instruction
  516.     CALL textshow(blank$,round(35),round(2))
  517.     PRINT tab( 9,40);"Press [Enter] or [Esc] to clear"
  518.     PRINT tab(10,40);"this area when table is shown."
  519.     PRINT tab(12,40);"If more than 20 sets are shown,"
  520.     PRINT tab(13,40);"use "&va$&", PgUp, & PgDn to scroll."
  521.     PRINT tab(15,40);"Press [PrtSc] or [F1] to print."
  522.     PRINT tab(17,40);"Press [D] to view decay chain."
  523. END SUB
  524.  
  525. SUB number_box(activity)
  526.     ! now get activity in curies
  527.     CALL highlight
  528.     CALL plain_double_edge_box(10,10,70,16)
  529.     PRINT tab(12,15);"Enter curies; any non-number key results in 1."
  530.     SET CURSOR "on"
  531.     SET CURSOR 14,33
  532.     CALL getkey(key)
  533.     SELECT CASE key
  534.     CASE 48 to 57
  535.          CALL Number(1,activity,33,14,14,key,false)
  536.     CASE else
  537.          LET activity = 1
  538.     END SELECT
  539.     SET CURSOR "off"
  540.     CALL normal
  541. END SUB
  542.  
  543. SUB scroll_it(b$(),a_max,first,last,first_row,last_row,up_down,left_col,right_col)
  544.     ! b$ is an array to be scrolled; width = right_col - left_col + 1
  545.     ! left_col and right_col are column bounds
  546.     ! first is index of first b$, it is returned to calling routine
  547.     ! last is index of last b$ on display, it is returned to calling routine
  548.     ! a_max is maximum dimension of b$
  549.     ! first_ and last_ row define the screen print range
  550.     LET net_rows = last_row - first_row + 1
  551.     SELECT CASE up_down
  552.     CASE 0                        ! initialize subroutine
  553.          FOR i = 1 to net_rows    ! fills from top down
  554.              PRINT tab(first_row+i-1,left_col); b$(first+i-1)
  555.          NEXT i
  556.          LET last = first + net_rows - 1
  557.     CASE 328                      ! up cursor
  558.          CALL up_one
  559.     CASE 329                      ! PgUp
  560.          FOR i = 1 to net_rows
  561.              CALL up_one
  562.          NEXT i
  563.     CASE 336                      ! down cursor
  564.          CALL down_one
  565.     CASE 337                      ! PgDn
  566.          FOR i = net_rows to 1 step -1
  567.              CALL down_one
  568.          NEXT i
  569.     CASE ELSE
  570.     END SELECT
  571.  
  572.     SUB down_one
  573.         ! move down one line - scroll page up one line
  574.         IF last < a_max then
  575.            CALL scroll(first_row,left_col,last_row,right_col,1)
  576.            LET last = last + 1
  577.            PRINT tab(last_row,left_col); b$(last);
  578.            LET first = first + 1
  579.         END IF
  580.     END SUB
  581.  
  582.     SUB up_one
  583.         ! move up one line - scroll page down one line
  584.         IF first > 1 then
  585.            CALL scroll(first_row,left_col,last_row,right_col,-1)
  586.            LET first = first - 1
  587.            PRINT tab(first_row,left_col); b$(first);
  588.            LET last = last - 1
  589.         END IF
  590.     END SUB
  591. END SUB
  592.  
  593. SUB read_doc1
  594.     DIM line$(105)
  595.     MAT READ line$
  596.     CLEAR
  597.  
  598.     DATA "                    GENERAL INFORMATION ABOUT RADDECAY"
  599.     DATA "               (C.A. Negin - Grove Engineering, Inc. - 10/87)"
  600.     DATA " "
  601.     DATA "1. INTRODUCTION"
  602.     DATA "RADDECAY is a program for displaying radioactive decay information for 497"
  603.     DATA "radionuclides.   Data provided include the half life, radioactive daughter"
  604.     DATA "nuclides, probabilities per decay, and decay product energies for alphas,"
  605.     DATA "betas, positrons, electrons, X-rays, and photons."
  606.     DATA " "
  607.     DATA "2. INSTRUCTIONS FOR THE FIRST-TIME USER"
  608.     DATA "All information regarding RADDECAY is on the system diskette.  To get started,"
  609.     DATA "use any drive and type ""RADDECAY"".  This will execute the program and make"
  610.     DATA "information available via menu selections.  The files may be copied to and"
  611.     DATA "executed from a hard disk.  There is no copy protection."
  612.     DATA " "
  613.     DATA "The second diskette contains seven ""record"" (random access) files which"
  614.     DATA "contain all the data.  They have an extension of "".REC"" with file names that"
  615.     DATA "are self explanatory.  These files do not have to be on the same drive or DOS"
  616.     DATA "directory as the system diskette files.  However, they must all be in one"
  617.     DATA "directory or sub-directory.  More information regarding these files can be"
  618.     DATA "read by selecting the file information menu item."
  619.     DATA " "
  620.     DATA "When RADDECAY executes, it initially reads a file in the same directory with"
  621.     DATA "the name RADDECAY.DAT.  This file contains parameters which control the screen"
  622.     DATA "colors and the DOS path to the data contained in the *.REC files.  If this"
  623.     DATA "file is not found, then one is created with:"
  624.     DATA " "
  625.     DATA "     a) Default screen colors. If you cannot see the screen because of"
  626.     DATA "        a strange color combination, press [Esc] from the menu to re-set them."
  627.     DATA " "
  628.     DATA "     b) The path to the *.REC files as the current directory from which"
  629.     DATA "        RADDECAY was executed."
  630.     DATA " "
  631.     DATA "When you set these parameters from RADDECAY main menu, they are retained in"
  632.     DATA "the RADDECAY.DAT file for the next time the program is run.  As received,"
  633.     DATA "there is no file on diskette, so it will be created with the defaults the"
  634.     DATA "first time it is used."
  635.     DATA " "
  636.     DATA "If you have a hard disk or an IBM-PC AT with a high capacity drive, we"
  637.     DATA "recommend that you create a subdirectory (for example, C:\RADDECAY\) on the"
  638.     DATA "high capacity drive and copy files RADDECAY.EXE, and all seven .REC files"
  639.     DATA "to it.  Then, when you first run RADDECAY, set the path and colors by"
  640.     DATA "pressing [Esc].  If you use the nuclide record files for other programs such"
  641.     DATA "as Grove Engineering's Microshield or MicroSkyshine, then you should set the"
  642.     DATA "record files path to the same subdirectory as for these programs.  This will"
  643.     DATA "avoid replicate copies of the same data on your hard disk."
  644.     DATA " "
  645.     DATA "3. PERMISSION FOR MAKING COPIES"
  646.     DATA "The two diskettes provided are ""plain vanilla"".  Permission is granted for"
  647.     DATA "making copies of RADDECAY without any restrictions."
  648.     DATA " "
  649.     DATA "4. PERMISSION FOR USE OF THE SOURCE CODE"
  650.     DATA "Source code provided is sufficient for checking the algorithms use in RAD-"
  651.     DATA "DECAY.  Programmers may use the source code to any extent they desire.  We"
  652.     DATA "heartily encourage microcomputers for engineering and analysis work. Note"
  653.     DATA "that you will not be able to compile RADDECAY without licensed True Basic"
  654.     DATA "library and Grove Engineering library routines for machine interaction. When"
  655.     DATA "you create a program that uses any of the .REC files, you should acknowledge:"
  656.     DATA " "
  657.     DATA "     a) RSIC (see  5. below) as the original source of the data, and"
  658.     DATA "     b) Grove Engineering as the originators of the microcomputer formatted"
  659.     DATA "       files."
  660.     DATA " "
  661.     DATA "5. SOURCE OF DATA AND DECAY ALGORITHM"
  662.     DATA "Thanks are due to the Radiation Shielding Information Center (RSIC) at Oak"
  663.     DATA "Ridge National Laboratories which provided the nuclides library information"
  664.     DATA "on diskette so that we could adapt it; and to Dick Bowers of the Perry Nuclear"
  665.     DATA "plant who provided the decay algorithm."
  666.     DATA " "
  667.     DATA "The data contained in these files from the RSIC were received in mid-1986 and"
  668.     DATA "is presumed current to that time.  These data are the same as that in:"
  669.     DATA " "
  670.     DATA "     RADIOACTIVE DECAY DATA TABLES"
  671.     DATA "     by David C. Kocher"
  672.     DATA "     Report DOE/TIC-11026"
  673.     DATA "     Technical Information Center"
  674.     DATA "     U.S. Department of Energy,"
  675.     DATA "     Washington, D.C., 1981"
  676.     DATA " "
  677.     DATA "which is available through NTIS.  We are grateful to RSIC, a government"
  678.     DATA "sponsored organization, for providing this public-domain information."
  679.     DATA " "
  680.     DATA "Grove Engineering added C-15 to this library for purposes of N-16 radiation"
  681.     DATA "shielding calculations.  Altogether, there are 497 nuclides."
  682.     DATA " "
  683.     DATA "6. CONVERSION TO MICROCOMPUTER FORMAT "
  684.     DATA "The data were converted to random access record files by:"
  685.     DATA " "
  686.     DATA "     Grove Engineering"
  687.     DATA "     15215 Shady Grove Road"
  688.     DATA "     Rockville, MD 20850"
  689.     DATA "     Phone (301) 258-2727"
  690.     DATA "    "
  691.     DATA "Dave Tocus is the programmer who did much of the neat stuff that makes this"
  692.     DATA "program extremely easy to use.  We used the True Basic programming system"
  693.     DATA "which proved to be outstanding.  The team of creators of RADDECAY are very"
  694.     DATA "pleased with the result.  We trust that you will find this program useful."
  695.     DATA " "
  696.     DATA "Grove Engineering provides energy and electricity-related engineering and"
  697.     DATA "management consulting services to utility, industrial, and maritime"
  698.     DATA "organizations; and to the U.S.Navy."
  699.     DATA "    "
  700.     DATA "                                             C.A. Negin"
  701.     DATA "                                             September/1987"
  702.     DATA " "
  703.     DATA "            ***** Press [Esc] to return to the main menu *****"
  704.     CALL highlight
  705.     PRINT tab(7);"Use scroll keys, PgUp, and PgDn to read file; press [Esc] to exit."
  706.     PRINT repeat$("─",80);tab(25,1);repeat$("─",80);
  707.     CALL normal
  708.     LET first = 1
  709.     CALL scroll_it(line$,ubound(line$),first,last,3,24,0,2,80)
  710.     DO
  711.        GET KEY key
  712.        SELECT CASE key
  713.        CASE 27
  714.             EXIT DO
  715.        CASE 328,329,336,337
  716.             CALL scroll_it(line$,ubound(line$),first,last,3,24,key,2,80)
  717.        CASE else
  718.        END SELECT
  719.     LOOP
  720. END SUB
  721.  
  722.  
  723. SUB read_doc2
  724.     DIM line$(143)
  725.     MAT READ line$
  726.     CLEAR
  727.  
  728.     DATA "            RADDECAY PROGRAMMING AND FILE STRUCTURE INFORMATION"
  729.     DATA "              (C.A. Negin - Grove Engineering, Inc - 10/87)"
  730.     DATA "1. OVERVIEW"
  731.     DATA "RADDECAY is a program for displaying radioactive decay information for 497"
  732.     DATA "radionuclides.  Data provided include the half life, radioactive daughter"
  733.     DATA "nuclides, probabilities per decay, and decay product energies for alphas,"
  734.     DATA "betas, positrons, electrons, X-rays, and gammas.  What we (with much work by"
  735.     DATA "Jody Fletcher) have done is taken the 80 column card image files provided by"
  736.     DATA "RSIC in a sequential order corresponding to atomic weight and atomic number,"
  737.     DATA "established an alphabetic sequence, generated individual record(random access)"
  738.     DATA "files that can be readily accessed by an IBM-PC compatable microcomputer, and"
  739.     DATA "provided a program to retrieve the information with user-oriented interaction."
  740.     DATA " "
  741.     DATA "Programmers with the TrueBasic language can write their own programs to access"
  742.     DATA "the data in accordance with the file specifications here.  This may also be"
  743.     DATA "possible with other languages, however, we haven't tried to do so.  We have"
  744.     DATA "chosen TrueBasic because:"
  745.     DATA " "
  746.     DATA "     - It automatically supports the math coprocesser."
  747.     DATA "     - All numbers and calculations are double precision; thus avoiding"
  748.     DATA "       roundoff anomolies (see below)."
  749.     DATA "     - The NUM$ function converts numbers to standard IEEE eight byte"
  750.     DATA "       format.  The eight bytes contain a sign bit, an 11 bit exponent,"
  751.     DATA "       and a 52 bit mantissa.  This means that numbers can be represented"
  752.     DATA "       in a range 1e-307 to 1e+307(roughly), with about 15 digits of"
  753.     DATA "       precision.  Refer to the source listing for use of the NUM function"
  754.     DATA "       which is for retrieval."
  755.     DATA "     - The structured nature of TrueBasic make it readily understood by"
  756.     DATA "       others who may wish to use parts of the program to create their own"
  757.     DATA "       applications."
  758.     DATA "     - TrueBasic is automatically compiled. (It does not run in an"
  759.     DATA "       interpreted mode.)"
  760.     DATA "     - The compiled code is easily bound into one executable program."
  761.     DATA "     - TrueBasic is supposed to be transportable between systems; although"
  762.     DATA "       we have yet to try."
  763.     DATA " "
  764.     DATA " "
  765.     DATA "2. RADDECAY FILES - SYSTEM DISKETTE"
  766.     DATA " "
  767.     DATA "RADDECAY.EXE - The compiled and bound executable code.  This was created by"
  768.     DATA "using the TrueBasic Bind (i.e., linker) program and runtime library which"
  769.     DATA "Grove Engineering has been licensed by TrueBasic, Inc."
  770.     DATA " "
  771.     DATA "*.TRU - source files may exist in True Basic language and format."
  772.     DATA "These files are not required to execute RADDECAY.  True Basic source"
  773.     DATA "code is in ASCII format and can be listed with the DOS PRINT or TYPE commands."
  774.     DATA "If you have the True Basic language, then you can import the code for use with"
  775.     DATA "the TrueBasic screen editor.  Any word processer should be able to import the"
  776.     DATA "source language."
  777.     DATA " "
  778.     DATA "3. RADDECAY RECORD FILES DISKETTE"
  779.     DATA "The record (random access) files contain all the data.  The program retrieval"
  780.     DATA "format, which is listed below, can also be found in the source code listing"
  781.     DATA "on the system diskette.  The seven record files and their format are:"
  782.     DATA " "
  783.     DATA "NUCLIDES.REC - Contains 497 records corresponding to an alphabetized list of"
  784.     DATA "radionuclides.  Each record contains single parameter information for the"
  785.     DATA "nuclide, pointer information to the location of the products of decay in the"
  786.     DATA "remaining record files, and the number of entries in each record file for each"
  787.     DATA "product of decay.  Each record contains 41 bytes, packed from left to right"
  788.     DATA "into 324 bits; that is, 40 bytes & 2 bits.  This packing was necessary to"
  789.     DATA "allow all the record files to fit on one diskette. The parameters in each"
  790.     DATA "record from left to right are in fields as follows:"
  791.     DATA " "
  792.     DATA "Start     Byte    Start   Bit"
  793.     DATA "Byte      Length   Bit   Length  Description of parameter(format)"
  794.     DATA " "
  795.     DATA "  1         8                    nuclide name (ASCII)"
  796.     DATA "  9         8                    atomic weight (IEEE)"
  797.     DATA " 17         1      129      8    atomic number (binary field,right justified)"
  798.     DATA " 18         8                    half life (IEEE)"
  799.     DATA " 26         1                    half life unit (ASCII) (S = seconds,"
  800.     DATA "                                 M = minutes, H = hours, D = days, Y = years)"
  801.     DATA " "
  802.     DATA "The format for all the remaining numbers in the record is a binary field,"
  803.     DATA "right justified within the bit field.  All numbers and pointers are for the"
  804.     DATA "nuclide named in the first field above. "
  805.     DATA " "
  806.     DATA "    Start     No."
  807.     DATA "     Bit     Bits      Description of parameter"
  808.     DATA " "
  809.     DATA "     209       2       number of daughters in the file PROGENY.REC"
  810.     DATA "     211       9       first daughter record number in PROGENY.REC"
  811.     DATA "     220       7       number of alphas in the file ALPHA.REC"
  812.     DATA "     227      13       first alpha record number in ALPHA.REC"
  813.     DATA "     240       8       number of betas in the file BETA.REC"
  814.     DATA "     248      13       first beta record number in BETA.REC"
  815.     DATA "     261       8       number of positrons in the file POSITRON.REC"
  816.     DATA "     269      13       first positron record number in POSITRON.REC"
  817.     DATA "     282       8       number of electrons in the file ELECTRON.REC"
  818.     DATA "     290      13       first electron record number in ELECTRON.REC"
  819.     DATA "     303       8       number of photons in the file PHOTON.REC"
  820.     DATA "     311      13       first photon record number in PHOTON.REC"
  821.     DATA " "
  822.     DATA "To retrieve the individual values, you will need to use the True Basic NUM"
  823.     DATA "function, which converts an eight byte string stored in IEEE format to a"
  824.     DATA "number, and the function UNPACKB which unpacks a specified bit field into an"
  825.     DATA "integer value."
  826.     DATA " "
  827.     DATA "The number of records in each of the remaining files are:"
  828.     DATA "                  number of         record length"
  829.     DATA "                   records             (bytes)"
  830.     DATA "PROGENY.REC          291                  16"
  831.     DATA "ALPHA.REC            360                  16"
  832.     DATA "BETA.REC            1700                  24"
  833.     DATA "POSITRON.REC         138                  24"
  834.     DATA "ELECTRON.REC        3882                  16"
  835.     DATA "PHOTON.REC          7480                  16"
  836.     DATA " "
  837.     DATA "All of the values in these files are stored in IEEE format and can be"
  838.     DATA "retrieved by using the True Basic NUM function."
  839.     DATA " "
  840.     DATA "The four files PROGENY.REC, ALPHA.REC, ELECTRON.REC, and PHOTON.REC have a"
  841.     DATA "format that consists of a 16 byte record into which two values are stored."
  842.     DATA " "
  843.     DATA "In each record of the file PROGENY.REC, the first value is the index of this"
  844.     DATA "daughter nuclide corresponding to the sequential order in which it appears in"
  845.     DATA "the file NUCLIDES.REC, and the second value is the branching ratio (i.e., the"
  846.     DATA "fractional yield) per decay of the parent."
  847.     DATA " "
  848.     DATA "In each record of the three files ALPHA.REC, ELECTRON.REC, and PHOTON.REC, the"
  849.     DATA "first value is the energy of the decay product, and the second value is the"
  850.     DATA "probability per decay (sometimes called ""abundance"").  Photons consist of both"
  851.     DATA "gammas and X-rays."
  852.     DATA " "
  853.     DATA "The two files BETA.REC AND POSITRON.REC have a format that consists of a 24"
  854.     DATA "byte record into which three values are stored.  The first value is the"
  855.     DATA "maximum energy of the decay product, the second value is the average energy,"
  856.     DATA "and the third value is the probability per decay."
  857.     DATA " "
  858.     DATA "4. OTHER FILES"
  859.     DATA "RADDECAY.DAT - A file containing parameters for color control and the DOS"
  860.     DATA "path to the *.REC files.  The purpose of this file is to allow automatic"
  861.     DATA "retrieval of parameters you set without having to reset them every time the"
  862.     DATA "program is started.  The parameters in this file are the path statement, the"
  863.     DATA "foreground color, and the background color.  If it is not present when"
  864.     DATA "execution starts, it will be created with default parameters."
  865.     DATA " "
  866.     DATA "RADDECAY uses other source code library files while compiling and binding"
  867.     DATA "(i.e., linking).  These libraries are the property of Grove Engineering, Inc."
  868.     DATA "or True Basic, Inc and may be licensed as appropriate to your use."
  869.     DATA " "
  870.     DATA "            ***** Press [Esc] to return to the main menu *****"
  871.     CALL highlight
  872.     PRINT tab(7);"Use scroll keys, PgUp, and PgDn to read file; press [Esc] to exit."
  873.     PRINT repeat$("─",80);tab(25,1);repeat$("─",80);
  874.     CALL normal
  875.     LET first = 1
  876.     CALL scroll_it(line$,ubound(line$),first,last,3,24,0,2,80)
  877.     DO
  878.        GET KEY key
  879.        SELECT CASE key
  880.        CASE 27
  881.             EXIT DO
  882.        CASE 328,329,336,337
  883.             CALL scroll_it(line$,ubound(line$),first,last,3,24,key,2,80)
  884.        CASE else
  885.        END SELECT
  886.     LOOP
  887. END SUB
  888.  
  889. SUB initialize_raddecay
  890.     ! 11/20/87 - added elemental data
  891.     MAT READ nuclide$
  892.     DATA "Ac-225  ","Ac-227  ","Ac-228  ","Ag-106m ","Ag-108  ","Ag-108m ","Ag-109m ","Ag-110  "
  893.     DATA "Ag-110m ","Ag-111  ","Al-26   ","Al-28   ","Am-241  ","Am-242  ","Am-242m ","Am-243  "
  894.     DATA "Am-244  ","Am-245  ","Am-246  ","Ar-37   ","Ar-39   ","Ar-41   ","As-72   ","As-73   "
  895.     DATA "As-74   ","As-76   ","As-77   ","At-211  ","At-217  ","Au-194  ","Au-195  ","Au-195m "
  896.     DATA "Au-196  ","Au-198  ","Au-199  ","Ba-131  ","Ba-133  ","Ba-133m ","Ba-135m ","Ba-137m "
  897.     DATA "Ba-139  ","Ba-140  ","Ba-141  ","Ba-142  ","Be-7    ","Be-10   ","Bi-206  ","Bi-207  "
  898.     DATA "Bi-208  ","Bi-210  ","Bi-211  ","Bi-212  ","Bi-213  ","Bi-214  ","Bk-249  ","Bk-250  "
  899.     DATA "Bk-251  ","Br-77   ","Br-80   ","Br-80m  ","Br-82   ","Br-83   ","Br-84   ","Br-85   "
  900.     DATA "C-11    ","C-14    ","C-15    ","Ca-41   ","Ca-45   ","Ca-47   ","Ca-49   ","Cd-109  ","Cd-111m "
  901.     DATA "Cd-113  ","Cd-113m ","Cd-115  ","Cd-115m ","Cd-117  ","Cd-117m ","Ce-139  ","Ce-141  "
  902.     DATA "Ce-143  ","Ce-144  ","Cf-248  ","Cf-249  ","Cf-250  ","Cf-251  ","Cf-252  ","Cf-253  "
  903.     DATA "Cf-254  ","Cl-36   ","Cl-38   ","Cm-242  ","Cm-243  ","Cm-244  ","Cm-245  ","Cm-246  "
  904.     DATA "Cm-247  ","Cm-248  ","Cm-249  ","Cm-250  ","Co-56   ","Co-57   ","Co-58   ","Co-58m  "
  905.     DATA "Co-60   ","Co-60m  ","Co-61   ","Cr-49   ","Cr-51   ","Cs-126  ","Cs-129  ","Cs-131  "
  906.     DATA "Cs-132  ","Cs-134  ","Cs-134m ","Cs-135  ","Cs-136  ","Cs-137  ","Cs-138  ","Cs-139  "
  907.     DATA "Cu-61   ","Cu-62   ","Cu-64   ","Cu-67   ","Dy-157  ","Dy-165  ","Dy-166  ","Er-169  "
  908.     DATA "Er-171  ","Es-253  ","Es-254  ","Es-254m ","Es-255  ","Eu-152  ","Eu-152m ","Eu-154  "
  909.     DATA "Eu-155  ","Eu-156  ","F-18    ","Fe-52   ","Fe-55   ","Fe-59   ","Fm-254  ","Fm-255  "
  910.     DATA "Fm-256  ","Fr-221  ","Fr-223  ","Ga-66   ","Ga-67   ","Ga-68   ","Ga-72   ","Gd-152  "
  911.     DATA "Gd-153  ","Gd-159  ","Gd-162  ","Ge-68   ","Ge-71   ","Ge-77   ","H-3     ","Hf-181  "
  912.     DATA "Hg-197  ","Hg-197m ","Hg-203  ","Ho-166  ","Ho-166m ","I-122   ","I-123   ","I-124   "
  913.     DATA "I-125   ","I-126   ","I-128   ","I-129   ","I-130   ","I-131   ","I-132   ","I-133   "
  914.     DATA "I-134   ","I-135   ","I-136   ","In-111  ","In-113m ","In-114  ","In-114m ","In-115  "
  915.     DATA "In-115m ","In-116m ","In-117  ","In-117m ","Ir-190  ","Ir-190m1","Ir-190m2","Ir-192  "
  916.     DATA "Ir-193m ","Ir-194  ","Ir-194m ","K-40    ","K-42    ","K-43    ","Kr-79   ","Kr-81   "
  917.     DATA "Kr-83m  ","Kr-85   ","Kr-85m  ","Kr-87   ","Kr-88   ","Kr-89   ","Kr-90   ","La-140  "
  918.     DATA "La-141  ","La-142  ","Lu-177  ","Lu-177m ","Mg-27   ","Mg-28   ","Mn-52   ","Mn-52m  "
  919.     DATA "Mn-53   ","Mn-54   ","Mn-56   ","Mn-57   ","Mo-91   ","Mo-93   ","Mo-99   ","Mo-101  "
  920.     DATA "N-13    ","N-16    ","Na-22   ","Na-24   ","Nb-90   ","Nb-91   ","Nb-91m  ","Nb-92   "
  921.     DATA "Nb-92m  ","Nb-93m  ","Nb-94   ","Nb-94m  ","Nb-95   ","Nb-95m  ","Nb-96   ","Nb-97   "
  922.     DATA "Nb-97m  ","Nd-147  ","Nd-149  ","Ni-56   ","Ni-57   ","Ni-59   ","Ni-63   ","Ni-65   "
  923.     DATA "Np-235  ","Np-236  ","Np-236m ","Np-237  ","Np-238  ","Np-239  ","Np-240  ","Np-240m "
  924.     DATA "O-15    ","Os-185  ","Os-186  ","Os-190m ","Os-191  ","Os-191m ","Os-193  ","P-32    "
  925.     DATA "P-33    ","Pa-230  ","Pa-231  ","Pa-233  ","Pa-234  ","Pa-234m ","Pb-203  ","Pb-204m "
  926.     DATA "Pb-205  ","Pb-209  ","Pb-210  ","Pb-211  ","Pb-212  ","Pb-214  ","Pd-103  ","Pd-107  "
  927.     DATA "Pd-109  ","Pm-143  ","Pm-144  ","Pm-145  ","Pm-146  ","Pm-147  ","Pm-148  ","Pm-148m "
  928.     DATA "Pm-149  ","Pm-151  ","Po-209  ","Po-210  ","Po-211  ","Po-212  ","Po-213  ","Po-214  "
  929.     DATA "Po-215  ","Po-216  ","Po-218  ","Pr-142  ","Pr-143  ","Pr-144  ","Pr-144m ","Pt-191  "
  930.     DATA "Pt-193  ","Pt-193m ","Pt-195m ","Pt-197  ","Pt-197m ","Pu-236  ","Pu-237  ","Pu-238  "
  931.     DATA "Pu-239  ","Pu-240  ","Pu-241  ","Pu-242  ","Pu-243  ","Pu-244  ","Pu-245  ","Pu-246  "
  932.     DATA "Ra-222  ","Ra-223  ","Ra-224  ","Ra-225  ","Ra-226  ","Ra-228  ","Rb-81   ","Rb-82   "
  933.     DATA "Rb-83   ","Rb-84   ","Rb-86   ","Rb-87   ","Rb-88   ","Rb-89   ","Rb-90   ","Rb-90m  "
  934.     DATA "Re-182  ","Re-182m ","Re-183  ","Re-184  ","Re-184m ","Re-186  ","Re-187  ","Re-188  "
  935.     DATA "Rh-103m ","Rh-105  ","Rh-105m ","Rh-106  ","Rn-218  ","Rn-219  ","Rn-220  ","Rn-222  "
  936.     DATA "Ru-97   ","Ru-103  ","Ru-105  ","Ru-106  ","S-35    ","Sb-117  ","Sb-122  ","Sb-124  "
  937.     DATA "Sb-125  ","Sb-126  ","Sb-126m ","Sb-127  ","Sb-129  ","Sc-44   ","Sc-46   ","Sc-46m  "
  938.     DATA "Sc-47   ","Sc-48   ","Sc-49   ","Se-73   ","Se-75   ","Se-79   ","Si-31   ","Si-32   "
  939.     DATA "Sm-147  ","Sm-151  ","Sm-153  ","Sn-113  ","Sn-117m ","Sn-119m ","Sn-123  ","Sn-125  "
  940.     DATA "Sn-126  ","Sr-82   ","Sr-85   ","Sr-85m  ","Sr-87m  ","Sr-89   ","Sr-90   ","Sr-91   "
  941.     DATA "Sr-92   ","Sr-93   ","Ta-182  ","Tb-157  ","Tb-160  ","Tb-162  ","Tc-95   ","Tc-95m  "
  942.     DATA "Tc-96   ","Tc-96m  ","Tc-97   ","Tc-97m  ","Tc-98   ","Tc-99   ","Tc-99m  ","Tc-101  "
  943.     DATA "Te-121  ","Te-121m ","Te-123  ","Te-123m ","Te-125m ","Te-127  ","Te-127m ","Te-129  "
  944.     DATA "Te-129m ","Te-131  ","Te-131m ","Te-132  ","Te-133  ","Te-133m ","Te-134  ","Th-226  "
  945.     DATA "Th-227  ","Th-228  ","Th-229  ","Th-230  ","Th-231  ","Th-232  ","Th-233  ","Th-234  "
  946.     DATA "Ti-44   ","Ti-45   ","Ti-51   ","Tl-200  ","Tl-201  ","Tl-202  ","Tl-204  ","Tl-207  "
  947.     DATA "Tl-208  ","Tl-209  ","Tl-210  ","Tm-170  ","Tm-171  ","U-230   ","U-231   ","U-232   "
  948.     DATA "U-233   ","U-234   ","U-235   ","U-236   ","U-237   ","U-238   ","U-239   ","U-240   "
  949.     DATA "V-48    ","V-49    ","V-52    ","W-181   ","W-185   ","W-187   ","W-188   ","Xe-122  "
  950.     DATA "Xe-123  ","Xe-125  ","Xe-127  ","Xe-129m ","Xe-131m ","Xe-133  ","Xe-133m ","Xe-135  "
  951.     DATA "Xe-135m ","Xe-137  ","Xe-138  ","Y-86    ","Y-87    ","Y-88    ","Y-90    ","Y-90m   "
  952.     DATA "Y-91    ","Y-91m   ","Y-92    ","Y-93    ","Yb-169  ","Yb-175  ","Zn-62   ","Zn-65   "
  953.     DATA "Zn-69   ","Zn-69m  ","Zr-86   ","Zr-88   ","Zr-89   ","Zr-93   ","Zr-95   ","Zr-97   "
  954.  
  955.     MAT READ at_names$
  956.     DATA Hydrogen,Helium,Lithium,Beryllium,Boron,Carbon,Nitrogen,Oxygen,Fluorine,Neon
  957.     DATA Sodium,Magnesium,Aluminum,Silicon,Phosphorus,Sulfur,Chlorine,Argon,Potassium,Calcium
  958.     DATA Scandium,Titanium,Vanadium,Chromium,Manganese,Iron,Cobalt,Nickel,Copper,Zinc
  959.     DATA Gallium,Germanium,Arsenic,Selenium,Bromine,Krypton,Rubidium,Strontium,Yttrium,Zirconium
  960.     DATA Niobium,Molybdenum,Technetium,Ruthenium,Rhodium,Palladium,Silver,Cadmium,Indium,Tin
  961.     DATA Antimony,Tellurium,Iodine,Xenon,Cesium,Barium,Lanthanum,Cerium,Praseodymium,Neodymium
  962.     DATA Promethium,Samarium,Europium,Gadolinium,Terbium,Dysprosium,Holmium,Erbium,Thulium,Ytterbium
  963.     DATA Lutetium,Hafnium,Tantalum,Tungsten,Rhenium,Osmium,Iridium,Platinum,Gold,Mercury
  964.     DATA Thallium,Lead,Bismuth,Polonium,Astatine,Radon,Francium,Radium,Actinium,Thorium
  965.     DATA Protactinium,Uranium,Neptunium,Plutonium,Americium,Curium,Berkelium,Californium,Einsteinium,Fermium
  966.  
  967.     MAT READ mol_wt
  968.     DATA    1.008,  4.0026,   6.939,  9.0122,  10.811, 12.0112, 14.0067, 15.9994
  969.     DATA  18.9984,  20.183, 22.9898,  24.312, 26.9815,  28.086, 30.9738,  32.064
  970.     DATA   35.453,  39.948,  39.102,   40.08,  44.956,    47.9,  50.942,  51.996
  971.     DATA   54.938,  55.847, 58.9332,   58.71,  63.546,   65.37,   69.72,   72.59
  972.     DATA  74.9216,   78.96,  79.904,    83.8,   85.47,   87.62,  88.905,   91.22
  973.     DATA   92.906,   95.94,      99,  101.07, 102.905,   106.4, 107.868,   112.4
  974.     DATA   114.82,  118.69,  121.75,   127.6, 126.904,   131.3, 132.905,  137.34
  975.     DATA   138.91,  140.12, 140.907,  144.24,     145,  150.35,  151.96,  157.25
  976.     DATA  158.924,   162.5,  164.93,  167.26, 168.934,  173.04,  174.97,  178.49
  977.     DATA  180.948,  183.85,   186.2,   190.2,   192.2,  195.09, 196.967,  200.59
  978.     DATA   204.37,  207.19,  208.98,     210,     210,     222,     223,  226.05
  979.     DATA      227, 232.038,     231,  238.03,     237,     244,     243,     245
  980.     DATA      249,     249,     254,     252
  981.  
  982.     MAT READ element_ID
  983.     DATA 89, 89, 89, 47, 47, 47, 47, 47, 47, 47, 13, 13, 95, 95, 95, 95
  984.     DATA 95, 95, 95, 18, 18, 18, 33, 33, 33, 33, 33, 85, 85, 79, 79, 79
  985.     DATA 79, 79, 79, 56, 56, 56, 56, 56, 56, 56, 56, 56,  4,  4, 83, 83
  986.     DATA 83, 83, 83, 83, 83, 83, 97, 97, 97, 35, 35, 35, 35, 35, 35, 35
  987.     DATA  6,  6,  6, 20, 20, 20, 20, 48, 48, 48, 48, 48, 48, 48, 48, 58
  988.     DATA 58, 58, 58, 98, 98, 98, 98, 98, 98, 98, 17, 17, 96, 96, 96, 96
  989.     DATA 96, 96, 96, 96, 96, 27, 27, 27, 27, 27, 27, 27, 24, 24, 55, 55
  990.     DATA 55, 55, 55, 55, 55, 55, 55, 55, 55, 29, 29, 29, 29, 66, 66, 66
  991.     DATA 68, 68, 99, 99, 99, 99, 63, 63, 63, 63, 63,  9, 26, 26, 26, 100
  992.     DATA 100,100,87, 87, 31, 31, 31, 31, 64, 64, 64, 64, 32, 32, 32,  1
  993.     DATA 72, 80, 80, 80, 67, 67, 53, 53, 53, 53, 53, 53, 53, 53, 53, 53
  994.     DATA 53, 53, 53, 53, 49, 49, 49, 49, 49, 49, 49, 49, 49, 77, 77, 77
  995.     DATA 77, 77, 77, 77, 19, 19, 19, 36, 36, 36, 36, 36, 36, 36, 36, 36
  996.     DATA 57, 57, 57, 71, 71, 12, 12, 25, 25, 25, 25, 25, 25, 42, 42, 42
  997.     DATA 42,  7,  7, 11, 11, 41, 41, 41, 41, 41, 41, 41, 41, 41, 41, 41
  998.     DATA 41, 41, 60, 60, 28, 28, 28, 28, 28, 93, 93, 93, 93, 93, 93, 93
  999.     DATA 93,  8, 76, 76, 76, 76, 76, 76, 15, 15, 91, 91, 91, 91, 91, 82
  1000.     DATA 82, 82, 82, 82, 82, 82, 82, 46, 46, 46, 61, 61, 61, 61, 61, 61
  1001.     DATA 61, 61, 61, 84, 84, 84, 84, 84, 84, 84, 84, 84, 59, 59, 59, 59
  1002.     DATA 78, 78, 78, 78, 78, 78, 94, 94, 94, 94, 94, 94, 94, 94, 94, 94
  1003.     DATA 94, 88, 88, 88, 88, 88, 88, 37, 37, 37, 37, 37, 37, 37, 37, 37
  1004.     DATA 37, 75, 75, 75, 75, 75, 75, 75, 75, 45, 45, 45, 45, 86, 86, 86
  1005.     DATA 86, 44, 44, 44, 44, 16, 51, 51, 51, 51, 51, 51, 51, 51, 21, 21
  1006.     DATA 21, 21, 21, 21, 34, 34, 34, 14, 14, 62, 62, 62, 50, 50, 50, 50
  1007.     DATA 50, 50, 38, 38, 38, 38, 38, 38, 38, 38, 38, 73, 65, 65, 65, 43
  1008.     DATA 43, 43, 43, 43, 43, 43, 43, 43, 43, 52, 52, 52, 52, 52, 52, 52
  1009.     DATA 52, 52, 52, 52, 52, 52, 52, 52, 90, 90, 90, 90, 90, 90, 90, 90
  1010.     DATA 90, 22, 22, 22, 81, 81, 81, 81, 81, 81, 81, 81, 69, 69, 92, 92
  1011.     DATA 92, 92, 92, 92, 92, 92, 92, 92, 92, 23, 23, 23, 74, 74, 74, 74
  1012.     DATA 54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 39, 39, 39, 39
  1013.     DATA 39, 39, 39, 39, 39, 70, 70, 30, 30, 30, 30, 40, 40, 40, 40, 40
  1014.     DATA 40
  1015. END SUB
  1016. END MODULE
  1017.